home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / turbodos.arc / PIBDODOS.PAS < prev    next >
Pascal/Delphi Source File  |  1985-12-13  |  13KB  |  254 lines
  1. (*$V-,R-*)
  2. PROGRAM PibDoDos;
  3.  
  4. (*--------------------------------------------------------------------------*)
  5. (*                                                                          *)
  6. (*     Program:  PibDoDos  v1.1                                             *)
  7. (*                                                                          *)
  8. (*     Purpose:  Demonstrate TURBORUN.COM, an assembler routine to          *)
  9. (*               execute DOS commands.                                      *)
  10. (*                                                                          *)
  11. (*     Author:   Philip R. Burns                                            *)
  12. (*     Version:  1.0                                                        *)
  13. (*     Date:     April, 1985                                                *)
  14. (*                                                                          *)
  15. (*     Author:   Thomas P. Devitt                                           *)
  16. (*     Version:  1.1                                                        *)
  17. (*     Date:     April 28, 1985                                             *)
  18. (*     Changes:  {*}                                                        *)
  19. (*                                                                          *)
  20. (*     Credits:  The external routine TURBORUN.COM was written by           *)
  21. (*               John Cooper and John Falconer.                             *)
  22. (*                                                                          *)
  23. (*               TURBORUN should be available on the same BBS as you found  *)
  24. (*               this program on.                                           *)
  25. (*                                                                          *)
  26. (*     Remarks:  This program demonstrates the external routine TURBORUN    *)
  27. (*               which allows Turbo Pascal programs to execute DOS commands *)
  28. (*               or other programs dynamically.  The environment string is  *)
  29. (*               searched for COMSPEC= to obtain the current setting of     *)
  30. (*               COMMAND.COM.  Then a prompt is issued for a command to be  *)
  31. (*               executed.  The command is passed to DOS for execution, if  *)
  32. (*               possible, and then control returns to this program.  The   *)
  33. (*               prompt for a new command is issued, and this continues     *)
  34. (*               until the command 'END' (in all capital letters) is        *)
  35. (*               entered.                                                   *)
  36. (*                                                                          *)
  37. (*               Note:  Entering a null line invokes a secondary copy of    *)
  38. (*                      the DOS command processor.  Enter an EXIT to get    *)
  39. (*                      back to this program.                               *)
  40. (*                                                                          *)
  41. (*     Glitches: DOS may freeze up if there is not enough memory to execute *)
  42. (*               the command, or if the command clobbers memory that does   *)
  43. (*               not belong to it.  In these cases, a re-boot is needed.    *)
  44. (*                                                                          *)
  45. (*               Note:  You should compile this to a .COM file, and set     *)
  46. (*                      the maximum heap size (A----) so that there is      *)
  47. (*                      enough memory for the program to be executed.       *)
  48. (*                                                                          *)
  49. (*--------------------------------------------------------------------------*)
  50. (*                                                                          *)
  51. (*     Send comments, suggestions, etc. to PHILIP BURNS on either of the    *)
  52. (*     following two Chicago BBSs:                                          *)
  53. (*                                                                          *)
  54. (*       Gene Plantz's BBS (312) 882 4227                                   *)
  55. (*       Ron Fox's BBS     (312) 940 6496                                   *)
  56. (*                                                                          *)
  57. (*--------------------------------------------------------------------------*)
  58.  
  59. CONST
  60.    NUL = #00                       (* Terminator for DOS Ascii z-strings *);
  61.  
  62. TYPE
  63.    AnyStr     = STRING[255];
  64.    Char_Array = ARRAY[1..1] OF CHAR;
  65.    Char_Ptr   = ^Char_Array;
  66.  
  67. VAR
  68.    Command_Line: AnyStr            (* Command to be executed       *);
  69.    Return_Code:  INTEGER           (* DOS return code              *);
  70.    ComSpec:      AnyStr            (* Comspec from DOS environment *);
  71.  
  72. {*}
  73.  
  74. (*--------------------------------------------------------------------------*)
  75. (*  RunExt is no longer the first item of user code.                        *)
  76. (*                                                                          *)
  77. (*  This function converts any string to upercase.                          *)
  78. (*--------------------------------------------------------------------------*)
  79.  
  80. FUNCTION UpCaseStr(S : AnyStr): AnyStr;
  81. var
  82.    i  : integer;
  83. begin
  84.    for i := 1 to length(S) do
  85.       S[i] := UpCase(S[i]);
  86.    UpCaseStr := S;
  87. end;
  88.  
  89. {*}
  90.  
  91. (*--------------------------------------------------------------------------*)
  92. (*    RunExt --- invoke external assembler program to execute DOS command   *)
  93. (*--------------------------------------------------------------------------*)
  94.  
  95. PROCEDURE RunExt( VAR Ret_Code: INTEGER;
  96.                   VAR Command_Line );
  97.  
  98. (*--------------------------------------------------------------------------*)
  99. (*                                                                          *)
  100. (*     Procedure:  RunExt (EXTERNAL ASM)                                    *)
  101. (*                                                                          *)
  102. (*     Purpose:    Performs DOS execute on given command                    *)
  103. (*                                                                          *)
  104. (*     Calling Sequence:                                                    *)
  105. (*                                                                          *)
  106. (*        RunExt( VAR Ret_Code: INTEGER;  VAR Command_Line );               *)
  107. (*                                                                          *)
  108. (*           Ret_Code     --- return code from DOS.                         *)
  109. (*           Command_Line --- contains command to be executed.              *)
  110. (*                            If parameter passed is a string, then         *)
  111. (*                            be sure to specify 'Command_Line[1]' as       *)
  112. (*                            the actual argument.                          *)
  113. (*                                                                          *)
  114. (*     Remarks:                                                             *)
  115. (*                                                                          *)
  116. (*        This routine is an external assembler routine.                    *)
  117. (*                                                                          *)
  118. (*--------------------------------------------------------------------------*)
  119.  
  120.    EXTERNAL 'TURBORUN.COM';
  121.  
  122.  
  123. (*--------------------------------------------------------------------------*)
  124. (*        Get_ComSpec --- Get location of Command.Com from environment      *)
  125. (*--------------------------------------------------------------------------*)
  126.  
  127. PROCEDURE Get_ComSpec( VAR ComSpec: AnyStr );
  128.  
  129. (*--------------------------------------------------------------------------*)
  130. (*                                                                          *)
  131. (*     Procedure:  Get_ComSpec                                              *)
  132. (*                                                                          *)
  133. (*     Purpose:    Gets location of COMMAND.COM from DOS environment        *)
  134. (*                                                                          *)
  135. (*     Calling Sequence:                                                    *)
  136. (*                                                                          *)
  137. (*        Get_Comspec( VAR ComSpec: AnyStr );                               *)
  138. (*                                                                          *)
  139. (*           ComSpec --- Returned file specification for COMMAND.COM        *)
  140. (*                       in 'drive:\directory\COMMAND.COM' form.            *)
  141. (*                                                                          *)
  142. (*     Calls:  None                                                         *)
  143. (*                                                                          *)
  144. (*     Remarks:                                                             *)
  145. (*                                                                          *)
  146. (*        This routine assumes that the COMSPEC= parameter actually exists  *)
  147. (*        in the environment (it should).                                   *)
  148. (*                                                                          *)
  149. (*--------------------------------------------------------------------------*)
  150.  
  151. CONST
  152.    ComSpec_String: String[7] = 'OMSPEC=';
  153.  
  154. VAR
  155.    Env_Ptr:     Char_Ptr;
  156.    Env_Pos:     INTEGER;
  157.    Env_Found:   BOOLEAN;
  158.    Spec_Pos:    INTEGER;
  159.    I:           INTEGER;
  160.  
  161. BEGIN (* Get_ComSpec *)
  162.                                    (* Initialize ComSpec to null string *)
  163.    ComSpec     := '';
  164.                                    (* Pick up starting address, offset of *)
  165.                                    (* DOS environment string.             *)
  166.  
  167.    Env_Ptr     := PTR( MEMW[ CSEG: $2C] , 0 );
  168.    Env_Pos     := 0;
  169.                                    (* Search for COMSPEC= in environment.  *)
  170.                                    (* Following will be file definition of *)
  171.                                    (* COMMAND.COM.                         *)
  172.    REPEAT
  173.                                    (* Look for initial 'C' of 'COMSPEC='   *)
  174.  
  175.       WHILE( Env_Ptr^[Env_Pos] <> 'C' ) DO
  176.          Env_Pos := Env_Pos + 1;
  177.                                    (* Flag indicating environment string   *)
  178.                                    (* has been found -- assume TRUE to     *)
  179.                                    (* start                                *)
  180.       Env_Found := TRUE;
  181.  
  182.       I        := 1;
  183.                                    (* Check characters after 'C'.  Are they *)
  184.                                    (* 'OMSPEC=' ?                           *)
  185.  
  186.       WHILE ( Env_Found AND ( I < 8 ) ) DO
  187.          IF Env_Ptr^[Env_Pos + I] = ComSpec_String[ I ] THEN
  188.             I := I + 1
  189.          ELSE
  190.             Env_Found := FALSE;
  191.  
  192.       Spec_Pos := Env_Pos + I;
  193.                                    (* If 'OMSPEC=' found, then we found  *)
  194.                                    (* the comspec.  If not, keep going.  *)
  195.  
  196.       IF ( I = 8 ) THEN
  197.          Env_Found := TRUE
  198.       ELSE
  199.          BEGIN
  200.             WHILE ( Env_Ptr^[Spec_Pos] <> NUL ) DO
  201.                Spec_Pos := Spec_Pos + 1;
  202.             Env_Pos := Spec_Pos;
  203.          END;
  204.  
  205.    UNTIL Env_Found;
  206.  
  207.                                    (* Pick up the COMMAND.COM definition  *)
  208.                                    (* following the COMSPEC=.             *)
  209.  
  210.    WHILE ( Env_Ptr^[Spec_Pos] <> NUL ) DO
  211.       BEGIN
  212.          ComSpec  := ComSpec + Env_Ptr^[Spec_Pos];
  213.          Spec_Pos := Spec_Pos + 1;
  214.       END;
  215.  
  216. END   (* Get_ComSpec *);
  217.  
  218. (*--------------------------------------------------------------------------*)
  219.  
  220. BEGIN (* PibDoDos -- Main Program *)
  221.  
  222.                                    (* Obtain location of Command.Com *)
  223.     Get_ComSpec( ComSpec );
  224.     Writeln('Comspec = ',ComSpec);
  225.  
  226.                                    (* Read commands until 'END' entered *)
  227.     REPEAT
  228.  
  229.        WRITELN;
  230.        WRITE('Enter command or END to stop: ');
  231.  
  232.        READLN( Command_Line );
  233. {*}    Command_Line := UpCaseStr(Command_Line);      {*}
  234.  
  235.        IF Command_Line <> 'END' THEN
  236.           BEGIN
  237.                                    (* Prefix comspec to command line *)
  238.  
  239.              IF LENGTH( Command_Line ) > 0 THEN
  240.                 Command_Line := ComSpec + ' /C ' + Command_Line + NUL
  241.              ELSE
  242.                 Command_Line := ComSpec + NUL;
  243.  
  244.                                    (* Execute the command *)
  245.  
  246.              RunExt( Return_Code , Command_Line[1] );
  247.  
  248.           END;
  249.  
  250.     UNTIL ( Command_Line = 'END' );
  251.  
  252. END   (* PibDoDos *).
  253.  
  254.